home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1995 April / Internet Tools.iso / infoserv / gopher / Unix / GopherTools / go4check1.1.Z / go4check1.1
Encoding:
Text File  |  1995-02-03  |  16.3 KB  |  438 lines
  1. #!/usr/local/bin/perl
  2. # go4check, v1.1
  3. #
  4. #-------------------------------------------------------------------------------
  5. # Introduction
  6. #   go4check checks gopher links, probing each connection and testing the 
  7. #   output received.  It handles most types of links, reporting if the link 
  8. #   is ok, the host serving it is down/refusing connections, or its pathname 
  9. #   has changed.  It is not 100% successful at this, especially when it 
  10. #   comes to gopher0 servers, but does indeed help you keep on top of links
  11. #   in your server(s).
  12. #
  13. #   To run, go4check requires only perl and socket.ph.  It understands
  14. #   gopher0 and gopher+ servers.
  15. #
  16. #   go4check produces a line of output on stdout for each item appearing 
  17. #   in a gopher's menu: the name of the item plus a result.  Indentation 
  18. #   serves to maintain items in context so problems can be located easily.
  19. #   As an extra benefit, go4check's output can be used as a roadmap of
  20. #   the gopher after some rather trivial editing to remove results.
  21. #
  22. #   go4check is written by George A. Theall, George.A.Theall@mail.tju.edu.  
  23. #   You may freely use and redistribute this.  I can not offer any
  24. #   support for this but am interested in your comments, suggestions,
  25. #   and problem reports.
  26. #
  27. #-------------------------------------------------------------------------------
  28. # Operation
  29. #   Before you run go4check, make sure perl and the header file socket.ph are
  30. #   available on your system. [You can generate this file by running the perl 
  31. #   utility h2ph on /usr/include/sys/socket.h, or something similar.]
  32. #
  33. #   Invoke go4check with the name of the server to check and an optional port
  34. #   number.  Other options can be used to specify a non-standard starting
  35. #   path or generate copious debugging info.  go4check will test the items
  36. #   listed in the initial menu and recurse into any menus it finds as long
  37. #   as the names of server it finds match the one specified at go4check's
  38. #   invocation. go4check does, though, skip recursion if pathnames refer 
  39. #   to ftp gateways or point back to the initial entry point.
  40. #
  41. #   Results are directed to stdout, so you probably will want to redirect
  42. #   to a file.  You might then remove instances of "...ok.", which
  43. #   indicate no problems and finally search on "...can't connect.",
  44. #   "...path changed.", and "...timed out.".  Another possible result 
  45. #   is "...n/a.", which is used when go4check doesn't know how to check 
  46. #   a particular type of link.
  47. #
  48. #   You may want to tune the variables that go4check uses for testing 
  49. #   items of type 2 and 7.  See below where initial values are defined.
  50. #   For items of type 2, go4check sends a invalid command, which causes
  51. #   many CSO servers to respond in a way that go4check interprets as a
  52. #   success.  As for items of type 7, I don't know of any robust way
  53. #   to test searches.  Currently, the best solution appears to be
  54. #   to search for a word that's common to whatever searches are in the
  55. #   gopher being checked.
  56. #
  57. #   go4check is slow; it probably belongs in a cron job to run at night.
  58. #
  59. #-------------------------------------------------------------------------------
  60. # History
  61. #   31-Jan-95, GAT, v1.1
  62. #      - Alarms are now used to abort connections that are otherwise hung.
  63. #      - Added patches from R.D. Cameron for supporting type 7 items with
  64. #        non-empty paths and checking error returns of type 3.
  65. #      - Fixed glitch that arose on some servers (gopher.uwsp.edu for one)
  66. #        that return lines with non-standard endings.
  67. #      - Explicitly added an assignment for $| and set it to true so output
  68. #        will be flushed after every print.
  69. #
  70. #   17-Oct-94, GAT
  71. #      - Added a semicolon after a line in make_URL.  Its lack appears to
  72. #        cause problems with some versions of Perl.
  73. #
  74. #   01-Sep-94, GAT, v1.0
  75. #      - Released publically.
  76. #
  77. #   10-Aug-94, GAT, v1.0b2
  78. #      - Added $snooze_length as a way to control how long to pause after
  79. #        establishing a connection.
  80. #      - Fixed initialization of %URLs.
  81. #      - Changed format of internal URLs by removing ":" from between type
  82. #        and path info.
  83. #      - Used a configurable word to check search items.
  84. #      - Added check of CSO servers.
  85. #      - Adjusted regular expression used to check success/failure of
  86. #        a link.
  87. #      - Documented go4check's operation.
  88. #
  89. #   12-Jul-94, GAT, v1.0b1
  90. #      - Used pseudo URLs internally for storing links so they are not
  91. #        checked more than once.
  92. #      - Added support for most types of links, including telnet, binary
  93. #        files, and searches.
  94. #      - Used gopher+ protocol whenever possible to avoid retrieving 
  95. #        entire files.
  96. #
  97. #   09-Jun-94, GAT, v1.0a
  98. #      - First version of go4check. Checks only files and directories.
  99. #
  100. #-------------------------------------------------------------------------------
  101.  
  102.  
  103. # Specify where perl can find include files.
  104. push(@INC, "/usr/local/lib/perl");
  105. push(@INC, "/usr/local/lib/perl/sys");
  106.  
  107.  
  108. # Define initial values for selected variables.
  109. $| = 1;                    # flush after every print?
  110. $default_path2 = "helo";        # for searching type 2 items
  111. $default_search_term = "cancer";    # for searching type 7 items
  112. $Indent = "  ";                # indentation at each level
  113. $snooze_length = 3;            # time to snooze after connect
  114. $timeout = 300;                # max len of connect (seconds)
  115. %URLs = ();                # array of URL's on server
  116.  
  117.  
  118. # Check for options.
  119. $DEBUG = 0;                # default to no debug
  120. if ($ARGV[0] eq '-d') {
  121.     shift;
  122.     $DEBUG = 1;
  123. }
  124.  
  125.  
  126. # Parse commandline args and provide help as needed.
  127. $inithost = shift || "";        # name of host to check
  128. $initport = shift || 70;        # port number
  129. $initpath = shift || "";        # initial directory
  130. if ($inithost eq "" || $inithost eq "-?") {
  131.     print "$0 checks links in a gopher by probing connections\n\n";
  132.     print "Usage:  $0 [-d] host [port] [\"path\"]\n";
  133.     print "        unless specified, port defaults to 70 and path to \"\".\n";
  134.     print "        -d is used for debugging.\n";
  135.     exit(9);
  136. }
  137.  
  138.  
  139. # Set up subroutines to catch some alarms.
  140. $SIG{'ALRM'} = handle_Timeout;
  141.  
  142.  
  143. # Establish connection and check links.
  144. require 'socket.ph';
  145. chop($thishost = `hostname`);        # needed for tcpconnect
  146. &check_Links($inithost, $initport, $initpath);
  147. exit(0);
  148.  
  149.  
  150. ########################################################################
  151. #  check_Links - checks links for a given directory.                   #
  152. #                                                                      #
  153. #  Notes:                                                              #
  154. #      - Links on the same host will be followed unless they point to  #
  155. #        the root.  While this will prevent most recursion, there may  #
  156. #        be some gophers with odd setups that lead to infinite loops.  #
  157. #      - FTP links are not followed.                                   #
  158. #  Entry:                                                              #
  159. #        host = hostname                                               #
  160. #        port = port number                                            #
  161. #        path = selector string                                        #
  162. #  Exit:                                                               #
  163. #        New links are appended to @URLs.                              #
  164. ########################################################################
  165. sub check_Links {
  166.     local($host, $port, $path) = @_;
  167.     local($margin) = $Indent . $margin;
  168.     local($stat);
  169.     local(@Items);
  170.  
  171.  
  172.     # Establish connection and read contents.
  173.     alarm($timeout);
  174.     $DEBUG && print "DEBUG: connecting to $host at port $port.\n";
  175.     ($GOPHER) = &tcpconnect($host, $thishost);
  176.     ($GOPHER) || die "Can't connect";
  177.     $DEBUG && print "DEBUG: sending path \"$path\".\n";
  178.     send($GOPHER, "$path\r\n", 0);
  179.     @Items = <$GOPHER>;
  180.     close($GOPHER);
  181.     alarm(0);
  182.  
  183.  
  184.     # Check each item, recursing into directories as necessary.
  185.     foreach (@Items) {
  186.         local($atype, $aname, $apath, $ahost, $aport, $aextra);
  187.  
  188.         s/\s*$//;        # remove \r\n combo
  189.         last if (/^\.$/);    # done if line is just a period
  190.  
  191.  
  192.         # Check status of each unique URL.
  193.         $url = &make_URL($_);
  194.         s/^(.)// && ($atype = $1);
  195.         ($aname, $apath, $ahost, $aport, $aextra) = split(/\t/, $_);
  196.         chop($ahost) if ($ahost =~ /\.$/);
  197.         if (defined($URLs{$url})) {    # already checked
  198.             print "$margin$aname...$URLs{$url}.\n";
  199.         }
  200.         else {
  201.             $stat = ($URLs{$url} = &test_URL($url, $aextra));
  202.             print "$margin$aname...$stat.\n";
  203.         }
  204.  
  205.  
  206.         # Recurse as necessary.
  207.         if ($stat eq "ok" && 
  208.                 $atype == 1 && 
  209.                 $ahost eq $inithost && 
  210.                 $aport eq $initport && 
  211.                 $apath ne "" &&
  212.                 $apath !~ /ftp.*:/) {
  213.             &check_Links($ahost, $aport, $apath);
  214.         }
  215.     }
  216. }
  217.  
  218.  
  219. ################################################
  220. #  make_URL - constructs a URL from a string.  #
  221. #                                              #
  222. #  Notes:                                      #
  223. #      - The URLs generated here are not 100%  #
  224. #        kosher, only used internally.         #
  225. #                                              #
  226. #  Entry:                                      #
  227. #        string as passed by gopher server.    #
  228. #  Exit:                                       #
  229. #        string representing URL.              #
  230. ################################################
  231. sub make_URL {
  232.     local($_) = @_;
  233.     local($url);
  234.     local($type, $name, $path, $host, $port);
  235.  
  236.  
  237.     s/^(.)// && ($type = $1);
  238.     ($name, $path, $host, $port) = split(/\t/, $_);
  239.     chop($host) if ($host =~ /\.$/);
  240.     if ($type =~ /[01245679sgMhIi]/) {
  241.         $url = "gopher://$host:$port/$type$path";
  242.     }
  243.     elsif ($type =~ /[8T]/) {
  244.         $url = "telnet://";
  245.         $path !~ /^$/ && $url .= "$path@";
  246.         $url .= $host;
  247.         $port > 0 && $url .= ":$port";
  248.         $url .= "/";
  249.     }
  250.     return($url);
  251. }
  252.  
  253.  
  254. ###########################################################################
  255. #  test_URL - check that a URL is accessible.                             #
  256. #                                                                         #
  257. #  Notes:                                                                 #
  258. #      - I don't have a good way to check gopher0 servers.  Currently, I  #
  259. #        look for the string "error.host", which servers like gn seem to  #
  260. #        generate.  However, this fails with KA9Q, for which an error     #
  261. #        message is indistinguishable from regular text.                  #
  262. #      - For gopher+, a error code indicating a server is too busy is     #
  263. #        treated as an error.  This may not be the right thing to do.     #
  264. #      - If the server understands gopher+, we'll only ask for info (!)   #
  265. #        so as not to retrieve large files.  This approach also seems to  #
  266. #        be the only way to check ASK blocks reliably.                    #
  267. #      - CSO nameservers (type 2) are checked with an invalid command -   #
  268. #        this returns a warning message from the server that is not       #
  269. #        regarded as an error by go4check. Using the command "fields"     #
  270. #        does *not* work since this typically results in lines starting   #
  271. #        with -2, which look like errors.                                 #
  272. #      - Checks of telnet links only see if host is up; no attempt        #
  273. #        is made to login to whatever account may be specified.           #
  274. #      - Checks of FTP links could be improved.  Currently, the info      #
  275. #        returned is not examined beyond looking for the usual signs      #
  276. #        of failure.                                                      #
  277. #  Entry:                                                                 #
  278. #        URL = URL to test                                                #
  279. #        GPLUS = extra character indicating a gopher+ item.               #
  280. #  Exit:                                                                  #
  281. #        Text string indicating status of URL:                            #
  282. #           "ok" = everything ok                                          #
  283. #           "can't connect" = can't connect to host                       #
  284. #           "path changed" = path changed                                 #
  285. #           "n/a" = unknown status                                        #
  286. ###########################################################################
  287. sub test_URL {
  288.     local($_, $gplus) = @_;
  289.     local($protocol, $logonid, $host, $port, $type, $path);
  290.     local($1, $2, $3, $4, $5);
  291.  
  292.  
  293.     $DEBUG && print "DEBUG: checking $_.\n";
  294.     m#^(\w+)://(.*):(\d+)/?(.?)(.*)#;
  295.     $protocol = $1;
  296.     $host = $2;
  297.     $port = $3;
  298.     $type = $4;
  299.     $path = $5;
  300.     if ($host =~ /@/) {
  301.         ($logonid, $host) = split(/@/, $host);
  302.     }
  303.     $DEBUG && print "protocol=$protocol; logonid=$logonid; host=$host; port=$port; type=$type; path=$path.\n";
  304.  
  305.  
  306.     # Check gopher links.
  307.     if ($protocol eq "gopher") {
  308.         local($GOPHER);
  309.         local($Stuff);
  310.  
  311.         $DEBUG && print "DEBUG: checking gopher at $host;$port.\n";
  312.         eval {
  313.             alarm($timeout);
  314.             ($GOPHER) = &tcpconnect($host, $thishost);
  315.             alarm(0);
  316.         };
  317.         if ($@ && $@ =~ /Timed Out/) {
  318.             return "timed out";
  319.         }
  320.         ($GOPHER) || return "can't connect";
  321.         $path .= "\t!" if ($gplus);    # Modify selector to get only info
  322.         if ($type eq "2") {
  323.             $path = $default_path2 if ($path =~ /^$/);
  324.         }
  325.         elsif ($type eq "7") {
  326.                 # Modification Oct. 19/94 by R.D. Cameron to append
  327.                 # handle the nonempty $path case:  to test in this
  328.                 # case, we send a tab and the search term after the
  329.                 # $path.
  330.             if ($path =~ /^$/) {
  331.                 $path = $default_search_term;
  332.             }
  333.             else {
  334.                 $path = "$path\t$default_search_term";
  335.             }
  336.             $path =~ s#^waissrc:(.*)/.*$#1$1#;
  337.         }
  338.         $DEBUG && print "DEBUG: sending path \"$path\".\n";
  339.         eval {
  340.             alarm($timeout);
  341.             send($GOPHER, "$path\r\n", 0);
  342.             alarm(0);
  343.         };
  344.         if ($@ && $@ =~ /Timed Out/) {
  345.             return "timed out";
  346.         }
  347.         $Stuff = <$GOPHER>;
  348.         close($GOPHER);
  349.         $DEBUG && print "DEBUG: read \"$Stuff\".\n";
  350.  
  351.  
  352.         # Test line for signs of errors.
  353.         #
  354.                 # Modification Oct. 19/94 by R.D. Cameron to 
  355.                 # check for type 3 error returns when a directory
  356.                 # listing is expected.  (According to the gopher 
  357.         # protocol, "3" as the first character of a directory
  358.         # entry always indicates error.
  359.         if ((($type eq "1") | ($type eq "7")) &
  360.             ($Stuff =~ /^3/)) {
  361.                         return("path changed");
  362.         }
  363.         # Test line for other signs of errors.
  364.         elsif ($Stuff =~ /(^\-\-\d)|(\terror.host\t\d+)/) {
  365.             return("path changed");
  366.         }
  367.         else {
  368.             return("ok");
  369.         }
  370.     }
  371.  
  372.  
  373.     # Check telnet links.
  374.     if ($protocol eq "telnet") {
  375.         local($TELNET);
  376.  
  377.         $DEBUG && print "DEBUG: checking telnet at $host;$port.\n";
  378.         ($TELNET) = &tcpconnect($host, $thishost);
  379.         ($TELNET) || return "host down";
  380.         return "ok";
  381.         close($TELNET);
  382.     }
  383.  
  384.  
  385.     # If we get here, we don't know how to test the link.    
  386.     return("n/a");
  387. }
  388.  
  389.  
  390. ################################################################
  391. #  This comes from gopherhunt by Paul Lindner.                 #
  392. #                                                              #
  393. #  I've added a line to abort if it can't resolve an address.  #
  394. #  and return 0 if failure rather than die. GAT                #
  395. ################################################################
  396. sub tcpconnect {                    #Get TCP info in place
  397.    local($host, $hostname) = @_;
  398.    local($name, $aliases, $type, $len);
  399.    local($thisaddr, $thataddr, $this, $that);
  400.    local($sockaddr);
  401.    $sockaddr = 'S n a4 x8';
  402.  
  403.    ($name,$aliases,$proto) = getprotobyname('tcp');
  404.    ($name,$aliases,$port) = getservbyname($port, 'tcp')
  405.         unless $port =~ /^\d+$/;
  406.    ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname);
  407.    ($name,$aliases,$type,$len,$thataddr) = gethostbyname($host);
  408.    $name || return(0);
  409.  
  410.    $this = pack($sockaddr, &AF_INET, 0, $thisaddr);
  411.    $that = pack($sockaddr, &AF_INET, $port, $thataddr);
  412.  
  413.    sleep($snooze_length);
  414.  
  415.    socket(N, &PF_INET, &SOCK_STREAM, $proto) || return(0);
  416.    bind(N, $this)                            || return(0);
  417.    connect(N, $that)                         || return(0);
  418.  
  419.    return(N);
  420. }
  421.  
  422.  
  423. #####################################################
  424. #  handle_Timeout - Die with a specific message.    #
  425. #                                                   #
  426. #  Notes:                                           #
  427. #        - Calls to alarm() should be in an eval    #
  428. #          block.                                   #
  429. #                                                   #
  430. #  Entry:                                           #
  431. #        n/a                                        #
  432. #  Exit:                                            #
  433. #        Message "Timed Out" is returned.           #
  434. #####################################################
  435. sub handle_Timeout { 
  436.     die "Timed Out";
  437. }
  438.